;<134-TENEX>ACCTJS.MAC;15     2-Jan-80 20:48:57    EDIT BY PETERS
; Fixed buggy JUMPLE to be JUMPL at ATGRP3
;<134-TENEX>ACCTJS.MAC;14     7-Dec-79 16:09:51    EDIT BY PETERS
; Removed .GTALC (never called, does nothing!)
;<134-TENEX>ACCTJS.MAC;13    14-Jun-77 23:03:06    EDIT BY LYNCH
; FIXED BUG IN CHGGRP TO FORCE NEW GROUP TO TAKE EFFECT IMMEDIATELY.
;<134-TENEX>ACCTJS.MAC;10    25-JUN-76 17:36:22    EDIT BY LYNCH
;<134-TENEX>ACCTJS.MAC;9    21-JUN-76 11:28:41    EDIT BY LYNCH
; INCLUDED ELF AS BELEAGURED ACCOUNT
;<134-TENEX>ACCTJS.MAC;8    17-JUN-76 19:03:51    EDIT BY LYNCH
;<134-TENEX>ACCTJS.MAC;7    19-APR-76 08:41:06    EDIT BY LYNCH
; TOOKOUT HACKON STUFF.  UTTER BULLSHIT!!!
;<134-TENEX>ACCTJS.MAC;4    24-FEB-76 19:45:31    EDIT BY UNTULIS
;ADDED CODE TO CLEAR LEFT HALF OF USER NUMBER BEFORE CALLIN DIRST
;FIX BUG IN MOVSTR ROUTINE THAT MADE GACTJF NOT WORK
;<134-TENEX>ACCTJS.MAC;3    18-FEB-76 09:21:25    EDIT BY UNTULIS
;<134-TENEX>ACCTJS.MAC;2    12-FEB-76 18:58:51    EDIT BY UNTULIS
;ADDED HACK CHECK IN VACCT
;<135-TENEX>ACCTJS.MAC;17    12-DEC-75 10:44:26    EDIT BY PLUMMER
; ADD EXTERN OF SKMRTN SO IT'S CAUGHT WITH OR WITHOUT PIESLC
;<135-TENEX>ACCTJS.MAC;15    13-NOV-75 11:26:26    EDIT BY CALVIN
; Added GTALC jsys & removed code that won't ever be used (PBYTE etc.)
;<135-TENEX>ACCTJS.MAC;14    13-NOV-75 10:12:02    EDIT BY CALVIN
; Own wait on busy code in ACTOPN
;<134-TENEX>ACCTJS.MAC;13    28-AUG-75 13:46:40    EDIT BY ALLEN
;<134-TENEX>ACCTJS.MAC;12    28-AUG-75 13:27:06    EDIT BY ALLEN
; STUFF FOR NEW CPU TIME UPDATING SCHEME FOR PIE-SLICE SCHED
;<134-TENEX>ACCTJS.MAC;11    11-JUL-75 14:11:06    EDIT BY CALVIN
;<134-TENEX>ACCTJS.MAC;10    10-JUL-75 16:54:11    EDIT BY CALVIN
; Fixed interlocking problem of ACTLCK & ACTLC2
;<134-TENEX>ACCTJS.MAC;9    30-JUN-75 10:49:44    EDIT BY CALVIN
; Fixed bug in matrix file initialization
;<134-TENEX>ACCTJS.MAC;8    25-JUN-75 17:40:23    EDIT BY ALLEN
; FIX BUG IN HASH ROUTINE
;<134-TENEX>ACCTJS.MAC;6    12-JUN-75 15:16:29    EDIT BY CALVIN
; Added ACTLKR to show locker of ACTLCK & fixed bug @ .ATGRP+3
;<134-TENEX>ACCTJS.MAC;5    28-APR-75 15:05:24    EDIT BY CLEMENTS
;<134-TENEX>ACCTJS.MAC;4    28-APR-75 12:16:54    EDIT BY CLEMENTS
;<134-TENEX>ACCTJS.MAC;3    28-APR-75 11:34:21    EDIT BY CLEMENTS
;<134-TENEX>ACCTJS.MAC;2     8-APR-75 19:43:16    EDIT BY CLEMENTS
;<134-TENEX>ACCTJS.MAC;1     8-APR-75 18:59:03    EDIT BY CLEMENTS
; SEPARATED FROM JSYS.MAC

SEARCH STENEX,PROLOG
TITLE ACCTJS

USE SWAPPC

EXTERN	MENTR,MRETN,BUGCHK,BUGHLT,JOBPT,SETMPG,CAPENB
EXTERN	SKMRTN

; Error macro definitions

DEFINE	ERUNLK(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERUNLD##]>

DEFINE	ERR(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERRD##]>

DEFINE	ERABRT(ERRORN,EXTRA)<
JRST [	EXTRA
	IFDIF <ERRORN>,<>,<MOVEI A,ERRORN>
	JRST ERABRD##]>

	NGS ACTONF			; FLAG TO DO JSYS ACCT CHK
	NGS ACTLCK			; LOCK FOR JSYS'S
	NGS ACTLC2			; FOR LOCKING OUT UPDATES
	NGS ACTLKR			; FORKX OF LAST LOCKER
	NGS ACTLK2			; FORKX FOR ACTLC2
	NGS MATORA			; ORIGIN OF MATRIX
	NGS MATBSA			; SIZE OF BYTES IN MATRIX
	NGS UHASHO			; ORIGIN OF USER TABLE
	NGS UHASHL			; LENGTH OF USER TABLE
	NGS AHASHO			; ORIGIN OF ACCOUNT TBL
	NGS AHASHL			; LENGTH OF SAME
	NGS DEFO			; ORIGIN OF DEFAULT ACCOUNTS
	NGS PRIO			; ORG OF PIE GROUP NAMES


	DEFINE	DS(X)
	<X=FH
	FH==FH+1>

	FH==0

	DS	LOCAL
	DS	MATORG
	DS	MATBSZ
	DS	RHASHO
	DS	RHASHL
	DS	CHASHO
	DS	CHASHL
	DS	DTABO
	DS	PTABO
	DS	FFREE
	DS	NFREE


; Definitions of internal error messages

	GRERR1==700000
	GRERR2==700001			; INVALID ROW/COLUMN INDEX
	HHERR1==700002			; HASH TABLE FULL
	PEERR1==700003			; INPUT STRING WAS NULL
	PEERR2==700004			; NOT ENOUGH FREE STORAGE SPACE



;
;	CGRP JSYS, Change pie slice GRouP
;
; Accepts:
;	1/ group name (SIXBIT)
; Returns:
;	+1 failure, error # in 1
;	+2 successful
;
; Requires WHEEL or OPER cap enabled
;

.CGRP::
IFE PIESLC,<
	MOVEI 1,PIEX1			; NOT A PIE SLICE SCHEDULER
	XCT MJRSTF
> ; END OF IFE PIESLC

IFN PIESLC,<
	JSYS MENTR
	MOVE 1,CAPENB			; CURRENTLY ENABLED BITS
	TRNN 1,WHEEL!OPER
	 ERR(WHELX1)			; PEON, TELL HIM SO
	UMOVE 1,1			; GET GROUP NAME
	CALL GRPLUK			; SEE IF EXISTS
	 ERR(CGRPX1)			; DOESN'T
	CALL CHGGRP			; CHANGE HIS GROUP
	CALL ASGDSH##			; RE-CALULATE WINDFALL AND SUCH
	JRST SKMRTN##			; AND LEAVE
> ; END IFN PIESLC

;
;	VACCT JSYS, Verify user account
;
; Accepts:
;	1/ user #, -1 for self
;	2/ account designator
; Returns:
;	+1 failure, error # in 1
;	+2 successful, account/user pair ok
;

.VACCT::JSYS MENTR
	SKIPE ACTONF			; CAN WE DO THIS RIGHT?
	 JRST SKMRTN			; NO, SAY IT'S OK
	UMOVE C,1			; GET USER #
	PUSH P,C			; AND SAVE IT
	CAME C,[-1]			; SELF?
	 JRST VACCT4			; NO
	MOVE B,CAPENB			; YES, NOW CHECK FOR WHEEL!OPER
	TRNE B,WHEEL!OPER
	 JRST SKMRTN			; IS, BELIEVE THE ACCOUNT
VACCT4:	MOVEI B,11			; NEED 11 WORDS
	NOINT
	CALL ASGJFR##
	 BUG(CHK,<VACCT: NO SPACE FOR USER NAME>)
	AOJ A,				; POINT PAST HDR
	EXCH A,0(P)			; STORE SPACE & GET USER #
	MOVE B,A
	CAMN B,[-1]			; SELF?
	 JRST [
		MOVE A,FORKX##
		SKIPGE B,FKDIR##(A)	; POINTER TO US?
		 MOVE B,FKDIR(B)	; YES, GET IT
		JRST .+1]
	HRRO A,0(P)			; WHERE TO PUT USER NAME
	HRRZS B		; CLEAR LEFT HALF OF USER #
	DIRST
	 ERR(VACX1,<CALL RLS1>)
	MOVEI B,11			; NEED THIS MUCH SPACE
	CALL ASGJFR
	 BUG(CHK,<VACCT: NO SPACE FOR STRING ACCT>)
	AOJ A,				; PAST HDR
	PUSH P,A			; SAVE LOCATION
	UMOVE C,2			; GET ACCT DESIGNATOR
	CAML C,[500000,,0]
	CAMLE C,[577777,,-1]
	 JRST VACCT1			; STRING ACCT
VACCT2:	CALL ACTOPN			; OPEN MATRIX
	PUSH P,A			; SAVE THE JFN
	HRRO B,-2(P)			; USER NAME
	TLO A,400000
	CALL GETB
VACCT3:	 ERR(GBERR1,<POP P,A		; JFN
		CALL ACTCLS
		CALL RLS2>)		; RELEASE SPACE
	TRNN D,2			; OK?
	 JRST VACCT3			; NO
	POP P,A
	CALL ACTCLS			; CLOSE MATRIX
	CALL RLS2			; AND RELEASE SPACE
	OKINT
	JRST SKMRTN

VACCT1:	MOVE B,C
	HRRO A,0(P)
	CALL CPYFU1##			; COPY STRING FROM USER
	 BUG(HLT,<VACCT: IMPOSSIBLE FAILURE OF CPYFU1>)
	MOVE	C,0(P)
	HRLI	C,(<POINT 7,0,35>)	;WHAT CPYFU1 DID TO US
	MOVE	A,1(C)		 ;GET FIRST WORD OF ACCOUNT STRING
	TRZ A,1			; WIPE OFF MISC BIT
	CAMN A,[ASCIZ /HACK/]	; IS IT THE HACK ACCOUNT?
	 JRST .+3		; YES, SO MAKE FURTHER CHECK
	CAME A,[ASCIZ /ELF/]	; OR ELF ?
	 JRST VACCT2		; NEITHER, SO CONTINUE
	PUSH P,C		; SAVE C
	SETO B,
	SETZ D,
	ODCNV			; GET CURRENT DAY AND TIME OF DAY
	HRRZ C,C
	CAIL C,5		; IS IT A WEEKEND
	 JRST VACCT5		; YES, SO LET THEM IN
	HRRZ D,D
	CAIL D,^D8*^D3600	; BEFORE 8 AM LOCAL?
	 CAIL D,^D22*^D3600	; OR AFTER 10 PM?
	  JRST VACCT5		; YES, SO LET ON SYSTEM
	MOVEI A,VACX2		; GIVE ERROR FOR NOW
	JRST ERRD
VACCT5:	POP P,C
	JRST VACCT2

RLS2:	MOVEI A,JSBFRE
	POP P,B
	EXCH B,0(P)			; GET ADR & SAVE RETURN ADR
	SOJ B,				; BACK UP TO HDR
	CALL RELFRE##
RLS1:	MOVEI A,JSBFRE
	POP P,B
	EXCH B,0(P)			; AS ABOVE
	SOJ B,				; BACK UP TO HDR
	CALL RELFRE
	RET


;
;	GDACC JSYS, Get default user account
;
; Accepts:
;	1/ E for string account
;	2/ user # (-1 for self)
; Returns:
;	+1 failure, error # in 1
;	+2 successful, account designator in 1
;

.GDACC::JSYS MENTR
	SKIPE ACTONF			; CAN WE DO THIS?
	 ERR(ACCTX1)
	MOVEI B,12			; NEED THIS MUCH SPACE
	NOINT
	CALL ASGJFR
	 BUG(CHK,<GDACC: NO SPACE FOR USER NAME>)
	AOJ A,				; PAST HDR
	PUSH P,A			; SAVE SPACE PTR
	UMOVE B,2			; GET USER #
	CAME B,[-1]			; SELF?
	 JRST GDACC3			; NO
	MOVE A,FORKX
	SKIPGE B,FKDIR(A)		; GET OUR DIR#
	 MOVE B,FKDIR(B)		; POINTER?
GDACC3:	HRRO A,0(P)
	HRRZS B				; WANT ONLY DIR #
	DIRST				; USER NAME
	 ERR(VACX1,<CALL RLS1>)		; BAD, RELEASE SPACE
	CALL ACTOPN			; OPEN MATRIX
	PUSH P,A			; SAVE JFN
	HRRO C,-1(P)			; POINTER TO NAME
	MOVE B,UHASHO
	HRL B,UHASHL
	CALL HASH
GDACC4:	 ERR(GDACX1,<POP P,A		; JFN
		CALL ACTCLS
		CALL RLS1>)		; SPACE
	JUMPL	4,GDACC4
	ADD 4,DEFO
	MOVE C,4
	RIN
	CAIGE B,0
	 ERR(GDACX2,<POP P,A
		CALL ACTCLS
		CALL RLS1>)
	MOVE C,B
	ADD C,AHASHO
	RIN
	CAML B,[500000,,0]		; NUMERIC?
	CAMLE B,[577777,,-1]
	 JRST .+2			; NO
	JRST GDACC1			; YES
	ANDI B,-1			; JUST BYTE ADR
	SFPTR
	 ERR(GDACX2,<POP P,A
		CALL ACTCLS
		CALL RLS1>)
	HRR B,-1(P)			; REUSE SPACE
	HRLI B,444400
	HRREI C,-10			; GET 10 WORDS OF STRING ACCT
	SIN
	IDPB C,B			; WORD OF NULLS
	MOVE B,-1(P)			; WHERE ACCOUNT IS
	HRLI B,440700
	CALL MOVSTR			; COPY TO USERS SPACE
GDACC1:	UMOVEM B,1			; GIVE USER COPY OF ACCT DESIG
	POP P,A
	CALL ACTCLS
	CALL RLS1			; REL SPACE
	OKINT
	JRST SKMRTN

MOVSTR:	UMOVE C,1
	HRLI C,440700
	PUSH P,C
MOVST1:	ILDB A,B
	JUMPE A,MOVST2
	XCTBU [IDPB A,C]
	JRST MOVST1
MOVST2:	XCTBU [IDPB A,C]
	POP P,B
	RET


;
;	ATGRP JSYS, Account to group
; Accepts:
;	1/ account designator
; Returns:
;	+1 failure, error # in 1
;	+2 success, SIXBIT group name in 2
;

.ATGRP::
IFE PIESLC,<
	MOVEI A,PIEX1			; NOT A PIE SLICE SCHED
	XCT MJRSTF> ; END OF IFE PIESLC
IFN PIESLC,<
	SKIPN ACTONF			; CAN WE DO THIS?
	 JRST .+3			; YES
	MOVEI A,ACCTX1			; ACCOUNT STUFF OFF
	XCT MJRSTF
	JSYS MENTR
	MOVEI B,11
	NOINT
	CALL ASGJFR			; GET SPACE FOR STR ACCT
	 BUG(CHK,<ATGRP: NO SPACE FOR STR ACCT>)
	AOJ A,				; PAST HDR
	PUSH P,A			; SAVE PTR
	UMOVE B,1			; GET ACCT DESIG
	CAML B,[500000,,0]
	CAMLE B,[577777,,-1]
	 JRST .+3			; STRING ACCT
	MOVE C,B
	JRST ATGRP2
	HRRO A,0(P)
	CALL CPYFU1			; GET IT
	 BUG(HLT,<ATGRP: IMPOSSIBLE FAILURE OF CPYFU1>)
	MOVE C,0(P)
	HRLI C,(<POINT 7,0,35>)
ATGRP2:	CALL ACTOPN			; OPEN MATRIX FILE
	PUSH P,A			; JFN
	MOVE B,AHASHO
	HRL B,AHASHL
	CALL HASH
ATGRP3:	 ERR(ATGPX1,<POP P,A
		CALL ACTCLS
		CALL RLS1>)
	JUMPL D,ATGRP3
	ADD D,PRIO			; OFFSET TO PIE GROUPS
	MOVE C,D
	RIN
	UMOVEM B,2
	POP P,A
	CALL ACTCLS
	CALL RLS1
	OKINT
	JRST SKMRTN
>; END OF IFN PIESLC


;
;	GACTJ - Get ACcounT of Job
;
; Accepts:
;	1/ E for string account (if one)
;	2/ job # (-1 for self)
; Returns:
;	+1 failure, error # in 1
;	+2 Successful, account designator in 1
;

.GACTJ::JSYS MENTR			; SLOW DOWN
	SETZ 5,				; CLEAR FLAG
	UMOVE A,2			; GET JOB #
	CAMN A,[-1]			; SELF?
	 MOVE A,JOBNO			; YES, FETCH IT
	CAIL A,0			; CHECK BOUNDS
	CAILE A,NJOBS			; RANGE
	 ERR(GCTJX1)			; WASN'T ANY GOOD
	CAMN A,JOBNO			; SELF?
	 JRST GACTJ1			; YES, SKIP JSB MAPPING
	SETO 5,				; SAY WE MAPPED A JSB
	NOSKED				; MAKE SURE THE JOB STAYS AROUND
	SKIPGE JOBRT##(A)			; MAKE SURE JOB'S THERE
	 ERR(GCTJX2,<OKSKED>)		; NO, COMPLAIN
	HRRZ A,JOBPT(A)			; GET TOP FORK INDEX
	HRRZ A,FKJOB##(A)			; GET JSB INDEX FOR TOP FORK
	MOVE B,[100000,,JSBPA]		; READ ONLY MAP
	NOINT				; DON'T BOTHER US HERE
	CALL SETMPG
	OKSKED
GACTJ1:	MOVE A,ACCTPT			; GET ACCOUNT DESIGNATOR
	SKIPE 5				; NEED STUFF FROM OTHER JSB
	 JRST GACTJ2			; YES
	CAML A,[500000,,0]		; CHECK FOR STRING ACCT
	CAMLE A,[577777,,-1]
	 JRST GACTJ4			; PROCESS AS ONE
GACTJ3:	UMOVEM A,1			; PASS BACK TO USER
	SKIPN 5				; NEED TO UNMAP JSB?
	 JRST SKMRTN			; NO, JUST LEAVE
	MOVEI 2,JSBPA			; WHERE IT IS
	SETZ 1,				; SAY UNMAP IT
	CALL SETMPG
	OKINT				; ALLOW INTS AGAIN
	JRST SKMRTN			; AND LEAVE

GACTJ2:	MOVEI A,ACCTPT
	ANDI A,777
	MOVE A,JSBPA(A)			; GET OTHER GUY'S ACCT DESIG
	CAML A,[500000,,0]
	CAMLE A,[577777,,-1]
	 JRST .+2
	JRST GACTJ3			; IS NUMERIC
	AND A,[-1,,777]			; GET RID OF PAGE #
	IORI A,JSBPA			; POINT TO RIGHT PLACE
GACTJ4:	MOVE B,A
	CALL MOVSTR
	MOVE A,B
	HRLI A,440700
	JRST GACTJ3



;
; GPSGN - Get Pie Slice Group Name of job
;
; Accepts:
;	1/ TENEX designator
;	2/ job # (-1 for self)
; Returns:
;	+1 error # in 1
;	+2 successful, updated string ptr in 1 (if pertinent)
;

.GPSGN::
IFE PIESLC,<
	MOVEI A,PIEX1			; NOT A PIE SLICE SCHED
	XCT MJRSTF
> ; END IFE PIESLC

IFN PIESLC,<
	SKIPN ACTONF			; VERIFICATION STUFF ON?
	 JRST .+3			; YES
	MOVEI A,ACCTX1			; NOT DOING VERIFICATION
	XCT MJRSTF
	JSYS MENTR
	UMOVE A,2			; GET JOB #
	CAMN A,[-1]			; SELF?
	 MOVE A,JOBNO			; YES, FIX THAT UP
	CAIL A,0			; CHECK JOB RANGE
	CAIL A,NJOBS
	 ERR(GCTJX1)			; OUT OF RANGE
	NOSKED				; MAKE SURE JOB STAYS AROUND
	SKIPGE JOBRT(A)			; DOES JOB EXIST?
	 ERR(GCTJX2,<OKSKED>)		; NO, COMPLAIN ABOUTHAT
	MOVE A,PIEGRP##(A)		; GET GROUP INDEX
	OKSKED
	IMULI A,NWDGRP			; TIMES OFFSET
	MOVE A,GRPNM##(A)			; GET SIXBIT ENTRY
	ADD P,BHC##+2			; SOME STRING SPACE (6 CHARS)
	MOVE B,[POINT 6,1]		; SIXBIT PTR INTO AC1
	MOVEI C,-1(P)			; WHERE TO PUT STRING
	HRLI C,440700
	MOVEI 5,6
GPSGN2:	ILDB D,B			; GET CHAR
	JUMPE D,GPSGN1			; IF WE HIT END EARLY
	ADDI D,40			; MAKE ASCII
	IDPB D,C
	SOJG 5,GPSGN2
	SETZ D,
GPSGN1:	IDPB D,C			; NULL AT THE END
	HRRZI A,-2(P)			; Where string is, but backed
					; up 1 for JFNSS
	CALL JFNSS##			; TO USERS CHOICE
	SUB P,BHC+2
	JRST SKMRTN
> ; END OF IFN PIESLC


ACTINI::SETOM ACTLC2
	SETOM ACTLCK			; INIT LOCK FIRST
	NOINT
	LOCK ACTLCK
	SKIPL ACTLC2			; ANY READERS?
	 CALL CNTLCK			; YES, STALL
	AOSE ACTLC2			; MAKE SURE BY LOCKING
	 BUG(HLT,<ACTINI: ACTLC2 ALREADY LOCKED UPON LOCKING>)
	SKIPN ACCIFG##			; RELOADING DISK?
	 JRST ACTIN5			; YES, THEN WE CAN'T DO THIS
	MOVSI 1,100001
	HRROI 2,ACTFIL			; POINT TO FILE NAME
	GTJFN
	 JRST	ACTIN4
ACTIN2:	MOVE 2,[440000,,203000]		; 36 BIT, RD, THAWED, WB
	OPENF
	 BUG(HLT,<ACTINI: Failed to open UACHK.FILE>)
	MOVEI 3,RHASHO			; ROW ORIGIN
	RIN
	MOVEM 2,UHASHO			; IS USER TBL ORIGIN
	MOVEI 3,RHASHL			; ROW LENGTH
	RIN
	MOVEM 2,UHASHL			; LENGTH OF USER TBL
	MOVEI 3,CHASHO			; COLUMN ORIGIN
	RIN
	MOVEM 2,AHASHO			; IS ACCOUNT ORIGIN
	MOVEI 3,CHASHL			; COLUMN TBL LENGTH
	RIN
	MOVEM 2,AHASHL			; LENGTH OF ACCT TBL
	MOVEI 3,DTABO			; DEFAULT ACCT TBL
	RIN
	MOVEM 2,DEFO			; ORIGIN OF THAT TABLE
	MOVEI 3,PTABO			; PIE SLICE GRP NAMES
	RIN
	MOVEM 2,PRIO			; ORIGIN OF THAT TABLE
	MOVEI 3,MATORG			; Get origin of table
	RIN
	MOVEM 2,MATORA			; And save
	MOVEI 3,MATBSZ			; Get size of bytes in matrix
	RIN
	MOVEM 2,MATBSA
	SETZ 2,
	CLOSF
	 JFCL
	SETZM ACTONF			; SET FLAG TO USABLE MATRIX
	SOSGE ACTLC2
	 SETOM GLOCK
	UNLOCK ACTLCK
	OKINT
	AOS 0(P)
	RET

ACTIN1::NOINT
	LOCK ACTLCK
	MOVE 1,FORKX			; FORK THAT'S RUNNING
	MOVEM 1,ACTLKR			; REMEMBER HIM
	SKIPL ACTLC2			; ANY READERS?
	 CALL CNTLCK			; YES
	AOSE ACTLC2			; LOCK IT
	 BUG(HLT,<ACTIN1: ACTLC2 ALREADY LOCKED UPON LOCKING>)
	MOVEM 1,ACTLK2
	HRROI 2,[ASCIZ/UACHK.FILE/]	; FROM CALLER'S DIR
	MOVSI 1,100001			; SHORT & READ
	GTJFN
	 JRST	ACTIN3
	MOVE 3,1			; SAVE MOMENTARILY
	MOVSI 1,400001			; FOR NEW VERSION
	HRROI 2,ACTFIL			; POINT TO FILE NAME
	GTJFN
	 JRST ACTIN3
	EXCH 3,1			; OTHER JFN
	MOVE 2,3
	RNAMF
	 JRST ACTIN3
	MOVE 1,2			; RECOVER GOOD JFN
	JRST ACTIN2			; PROCEED AS BEFORE

ACTIN4:	BUG(CHK,<ACTINI: Failed to find UACHK.FILE>)
ACTIN5:	SETOM ACTONF
ACTIN3:	SOSGE ACTLC2
	 SETOM GLOCK			; WAKE UP WAITING GUYS
	UNLOCK ACTLCK
	OKINT
	RET	 			; RETURN FAILURE


ACTFIL:	ASCIZ/<SYSTEM>UACHK.FILE/

ACTOPN:	NOINT
	LOCK ACTLCK
	MOVE 1,FORKX
	MOVEM 1,ACTLKR
	AOS ACTLC2
	MOVEM 1,ACTLK2
	UNLOCK ACTLCK
	MOVSI 1,100001			; SHORT & READ
	HRROI 2,ACTFIL
	GTJFN
	 BUG(HLT,<ACTOPN: Unable to find UACHK.FILE>)
	PUSH P,A			; Save JFN
	MOVE 2,[440000,,200000]		; 36 BIT, RD, THAWED, WB
ACTOP1:	MOVE A,0(P)			; JFN
	OPENF
	 JRST	[			; ?
		CAIE A,OPNX9		; Busy?
		 JRST ACTOP2		; No, tell 'em
		MOVEI A,^D1000		; Wait a second
		DISMS
		JRST ACTOP1]
	POP P,A				; JFN
	RET

ACTOP2:	BUG(HLT,<ACTOPN: Unable to open UACHK.FILE>)
	POP P,A
	RLJFN
	 JFCL
	ERR(ACCTX1)			; Cause JSYS to fail

ACTCLS:	SETZ 2,				; CLOSE UACHK.FILE
	CLOSF
	 JFCL
	SOSGE ACTLC2
	SETOM GLOCK##
	OKINT
	RET

;
;	This routine accepts row and column indicies, relative to 0,
; and returns a standard PDP10 byte pointer in 3. This pointer can
; then be used to acces the desired byte.
;

;
; Accepts:
;	1/ open jfn
;	2/ row,,column indices (rel 0)
; Returns:
;	+1 failure, error # in 1
;	+2 successful, byte pointer in 3
;

GBPTR:	PUSH	P,B			; SAVE ROW,,COLUMN
	HLRZ B,B			; ROW INDEX
	CAMLE B,UHASHL			; IN USER RANGE?
	 JRST	[
		MOVEI	A,GRERR1	; ERROR NUMBER
		JRST	ERR4]
	HRRZ	B,0(P)			; COLUMN INDEX
	CAMLE B,AHASHL			; WITHIN ACCT LIMITS?
	 JRST	[
		MOVEI	A,GRERR2	; TO BIG
		JRST	ERR4]
;  Now compute byte number in matrix
	MOVE B,AHASHL
	HLRZ	C,0(P)			; GET ROW INDEX
	IMUL	B,C			; BYTES/COLUMN
	HRRZ	C,0(P)			; GET COLUMN INDEX
	ADD	B,C			; BYTE INDEX INTO MATRIX
	PUSH	P,B			; SAVE IT FOR NOW
	MOVE	C,MATBSA		; COMPUTE BYTES/WORD
	MOVEI	B,^D36
	IDIV	B,C			; BYTES/WORD
	MOVE	C,B			; COMPUTE WORD INDEX & BYTE
	MOVE	B,0(P)			; INDEX INTO WORD
	IDIV	B,C			; B=WORD INDEX, C=BYTE INDEX
	PUSH	P,B			; SAVE THEM
	MOVE B,MATORA			; GET MATRIX ORIGIN
	ADD	B,0(P)			; ADD WORD INDEX
	MOVEM	B,0(P)			; SAVE
	ADDI	C,1			; COMPUTE "P" PORTION OF POINTER
	IMUL	C,MATBSA
	MOVEI	B,^D36
	SUB	B,C
	LSH	B,^D30			; PUT IN THE RIGHT PLACE
	MOVE	C,MATBSA		; NOW "S" PORTION
	LSH	C,^D24
	IOR	B,C
	IOR	B,0(P)			; BRING IN THE WORD PORTION
	SUB	P,[XWD 2,2]		; CLEAN UP STACK
	MOVE	C,B			; RETURN POINTER IN 3
	POP	P,B			; RESTORE 2
	AOS	(P)			; SUCCESSFUL RETURN
	POPJ	P,

ERR4:	POP	P,B
	POPJ	P,			; FAILED, ERROR # IN 1





;
;	This routine accepts a row and column index and returns
; the corresponding matrix entry.
;

;
; Accepts:
;	1/ open jfn
;	2/ row,,column (indicies rel 0)
; Returns:
;	+1 failure, error # in 1
;	+2 successful, byte in 3
;

GBYTE:	PUSHJ	P,GBPTR			; CONVERT TO POINTERS
	 POPJ	P,			; RETURN FAILURE
	PUSH	P,B			; SAVE INDICIES
	PUSH	P,C			; SAVE POINTER
	ANDI	C,777777		; SAVE ONLY WORD INDEX
	RIN				; GET THE WORD WITH THE BYTE
	MOVEI	C,B			; ADDRESS OF WORD
	HRRM	C,0(P)			; SAVE AS RH OF POINTER
	LDB	C,0(P)			; GET THE BYTE
	POP	P,B			; POINTER IS NOW GARBAGE
	POP	P,B			; INDICES
	AOS	(P)			; SUCCESSFUL
	POPJ	P,



;
;	This routine accepts row and column designators and returns
; the byte which exits at their intersection in the matrix.
;

;
; Accepts:
;	1/ open jfn, if b0=1, return hash tbl indices in 5&6
;	2/ row designator
;	3/ column designator
; Returns:
;	+1 failure, error # in 1
;	+2 successful, byte in 4
;

GETB:	PUSH	P,A			; SAVE JFN
	PUSH	P,B			; ROW DESIGNATOR
	PUSH	P,C			; COLUMN DESIGNATOR
	TLZ	A,400000		; TURN OFF B0 IF ON
	HRL	B,UHASHL		; ARRANGE AS LEN,,ORG
	HRR	B,UHASHO
	MOVE	C,-1(P)			; ROW DESIGNATOR
	PUSHJ	P,CALLH			; CALL HASH CALLER
	 JRST	ERR5			; HASH FAILED
; ROW INDEX NOW IN 4
	HRL	D,D			; SAVE IT IN LH
	PUSH	P,D
	SKIPGE	-3(D)			; SAVING INDICIES?
	HRRZ	5,D			; YES
; NOW DO ABOVE CRAP FOR COLUMN
	HRL	B,AHASHL
	HRR	B,AHASHO		; LEN,,ORG IN 2
	MOVE	C,-1(P)			; COLUMN DESIGNATOR
	PUSHJ	P,CALLH			; CALL HASH CALLER
	 JRST	[
		POP	P,B		; EXTRA STUFF
		JRST	ERR5]
; COL INDEX NOW IN D
	HRRM	D,0(P)			; ROW,,COL INDICES
	SKIPGE	-3(P)			; RETURNING INDICIES?
	MOVE	6,D
	POP	P,B
	PUSHJ	P,GBYTE
	 JRST	ERR5
	MOVE	D,C			; RETURN THE BYTE
	POP	P,C
	POP	P,B
	SUB	P,[XWD 1,1]
	AOS	(P)			; SUCCESSFUL RETURN
	POPJ	P,

ERR5:	POP	P,C
	POP	P,B
	SUB	P,[XWD 1,1]
	POPJ	P,

CALLH:	PUSHJ	P,HASH			; CALL THE HASHER
	POPJ	P,			; DIDN'T
	SKIPGE	D			; WAS IT FOUND?
	 JRST	[
		MOVEI	A,GBERR1	; NOPE
		POPJ	P,]
	AOS	(P)
	POPJ	P,



	G==7
	H==10
	I==11
	J==12
	K==13
	L==14
	M==15
	N==16

;	THIS ROUTINE ACCEPTS A HASH TABLE DESCRIPTION (ADDRESS
;	AND LENGTH) AND A DESIGNATOR. IT HASHES ON THE DESIGNATOR
;	IN AN ATTEMPT TO FIND THE CORRESPONDING ENTRY IN THE HASH
;	TABLE, IF IT EXISTS. IF IT DOES NOT EXIST, IT WILL
;	RETURN THE LOCATION OF AN ENTRY SUITABLE FOR MAKING A NEW
;	ENTRY. IF SPACE FOR THE LATTER CANNOT BE FOUND (THE TABLE
;	IS FULL), THE ROUTINE INDICATES THIS BY ITS ERROR RETURN.

;	CALLING SEQUENCE:

;	AC1=AN OPEN JFN
;	AC2=LENGTH,,ADDRESS OF HASH TABLE
;	AC3=THE DESIGNATOR

;	RETURNS:
;	+1 IF ERROR. ERROR CODE IN AC1
;	+2 IF SUCCESSFUL. INDEX INTO HASH TABLE IN AC4.
;		B0=0 -> ENTRY WAS FOUND
;		B0=1 -> ENTRY NOT FOUND. INDEX POINTS TO LOC. WHICH
;			CAN BE USED FOR NEW ENTRY.
;	NOTE THAT THE DESIGNATOR CAN BE EITHER A VALUE OR A POINTER
;	TO AN ASCIZ-TYPE STRING. THEY ARE DISTINGUISHED BY THE PRESENCE
;	OF OCTAL 5 IN THE HIGH ORDER DIGIT, INDICATING THE LOW ORDER
;	33 BITS ARE TO BE TREATED AS THE VALUE TO BE USED FOR HASHING.

;	AC USE:

;	A: CONTAINS JFN
;	B: RESERVED TO RECEIVE WORDS FROM FILE (RIN)
;	C: CONTAINS CURRENT FILE WORD INDEX
;	D: CONTAINS ADDRESS OF HASH TABLE
;	E: CONTAINS LENGTH-1 OF HASH TABLE
;	F: CONTAINS DESIGNATOR
;	G: USED TO RETAIN FIRST PROBE ADDRESS
;	H: USED TO RETAIN ADDRESS OF FIRST DELETED ENTRY
;	I: FILE WORD INDEX OF LAST ENTRY IN HASH TABLE
;	J: WORK REGISTER
;	K: WORK REGISTER
;	L: WORK REGISTER
;	M: WORK REGISTER
;	N: WORK REGISTER


HASH:	PUSH P,B			; Save b,c & d
	PUSH P,C
	PUSH P,D
	HRRZ	D,B	;ADDRESS OF HASH TABLE
	HLRZ	5,B	;LENGTH OF HASH TABLE
	SUBI	5,1	;LESS ONE

	MOVE 	6,C	;DESIGNATOR

	TLC 6,-1			; DEFAULT POINTER?
	TLCN 6,-1
	 HRLI	6,440700	;MAKE IT A VALID BYTE POINTER

	MOVE	I,D
	ADD	I,5	;POINTER TO LAST ENTRY

	SETZ	H,	;INITIALIZE

;NOW APPLY INITIAL HASH FUNCTION
	PUSHJ	P,HASH1	;RETURNS WITH PROBE ADDRESS IN C, CONTENTS IN B
	MOVE	G,C	;SAVE INITIAL PROBE ADDRESS

;TEST FOR EMPTY CELL
TESTEM:	JUMPE	B,EXITNF	;CELL IS EMPTY, EXIT

;TEST FOR DELETED CELL. SAVE ADDRESS OF DELETED CELL IF IT IS FIRST ONE
;ENCOUNTERED.
	CAMN	B,[-1]
	JRST	[JUMPE H,NEXT
		MOVE H,C
		JRST NEXT]

;TEST FOR DESIGNATOR EQUALITY
	PUSHJ	P,COMPAR
	JRST	EXITF	;THEY'RE EQUAL, EXIT.

;APPLY SUCCESSOR FUNCTION.
NEXT:	ADDI	C,1

	CAILE	C,0(I)	;HAVE WE GONE OFF THE END OF THE TABLE?
	MOVE 	C,D	;YES, RESET TO BEGINNING

	CAIN	C,0(G)	;ARE WE BACK TO INITIAL PROBE LOCATION?
	JRST	NOEMPT	;YES

	RIN		;GET THE ENTRY
	JRST	TESTEM	;GO BACK AND DO CHECKS

;EXIT, RETURNING FIRST DELETED ENTRY FOUND
NOEMPT:	JUMPE	H,[MOVEI A,HHERR1	;NO DELETED ENTRIES,TABLE IS FULL
		JRST	ERREX]

	MOVE	C,H	;GET FIRST DELETED ENTRY FOUND

;EXIT, INDICATING ENTRY NOT FOUND. RETURN LOCATION IN C.
EXITNF:	TLOA	C,400000	;SET HIGH ORDER BIT AND SKIP

;EXIT, INDICATING ENTRY FOUND. RETURN LOCATION IN C.
EXITF:	TLZ	C,400000	;RESET HIGH ORDER BIT -- NO SKIP
	SUB	C,D	;RETURN INDEX INTO HASH TABLE (NOT ADDRESS)
	MOVE D,C			; Return index
	POP P,B				; Junk
	POP P,C
	POP P,B
	AOS	0(P)	;RETURN +2
	POPJ	P,

;ERROR EXIT
ERREX:	POP P,D
	POP P,C
	POP P,B
	POPJ	P,	;RETURN+1


;COMPARISON ROUTINE FOR NUMERIC OR STRING DESIGNATORS
COMPAR:	CAML 6,[500000,,0]
	CAMLE 6,[577777,,-1]
	 JRST	COMPST		;ITS STRING

;DO COMPARISON OF NUMERIC DESIGNATORS
	CAME	6,B
COMP1:	AOS	0(P)	;RETURN+2 IF UNEQUAL
	POPJ	P,

;DO STRING COMPARISON

;THE STRING POINTED TO BY THE HASH TABLE ENTRY (WHICH IS SITTING IN B)
;IS READ FROM THE FILE A WORD AT A TIME INTO B. THE BYTES ARE EXTRACTED
;FROM B TO K USING A BYTE POINTER IN M.
;THE ARGUMENT STRING IS ACCESSED VIA THE BYTE POINTER IN F (WHICH IS
;PRESERVED ACROSS THE CALL TO THIS ROUTINE ON THE STACK).
;THE BYTES ARE EXTRACTED TO L. K AND L ARE COMPARED; IF UNEQUAL, THE
;"UNEQUAL" EXIT IS TAKEN. IF EQUAL, K IS TESTED FOR ZERO WHICH
;INDICATES END-OF-STRING. IF ZERO, THE "EQUAL" EXIT IS TAKEN; ELSE
;COMPARISON PROCEEDS WITH THE NEXT BYTES.
COMPST:	PUSH	P,C	;SAVE C ON STACK
	CAML B,[500000,,0]
	CAMLE B,[577777,,-1]
	 JRST COMP3			; IS A STRING
	POP P,C		;NOT A STRING, DECLARE UNEQUAL
	JRST COMP1

COMP3:	HRRZ	C,B	;MOVE STRING ADDRESS TO C FOR RIN.
	PUSH	P,6	;SAVE F ON THE STACK
	PUSH P,16			; SAVE THIS TOO
	RIN		;GET FIRST WORD OF STRING
	SKIPA
COMPL:	BIN		;GET NEXT WORD
	MOVE	M,[XWD 440700,B]	;SET UP BYTE POINTER
	MOVEI 16,5			; # CHARS IN A WORD
COMPL2:	SOJL 16,COMPL			; HAVE WE DONE 5 BYTES?
	ILDB	K,M	;GET BYTE FROM B
	ILDB	L,6	;GET BYTE FROM ARGUMENT STRING
	CAIE	K,0(L)	;ARE THEY EQUAL?
	 JRST	[POP P,16
		POP P,6	;NOT EQUAL
		POP P,C
		AOS 0(P)	;RETURN +2
		POPJ P,  ]

;THEY'RE EQUAL. ARE THEY ZERO?
	JUMPN	K,COMPL2	;NOT ZERO, CONTINUE COMPARISON

;TAKE "EQUAL" EXIT
	POP P,16
	POP	P,6	;RESTORE F
	POP	P,C	;RESTORE C
	POPJ	P,

;PRIMARY HASHING FUNCTION FOR NUMERIC AND STRING DESIGNATORS
HASH1:	MOVE K,6
	TLC K,500000
	TLNE K,700000
	 JRST	HASHST	;ITS A STRING

;APPLY HASH FUNCTION TO VALUE IN K
HASH2:	SETZ	B,	;PREPARE FOR DIVIDE
	MOVE	C,K
	DIV	B,5	;K MOD LENGTH
	ADD	C,D	;PLUS ORIGIN OF TABLE

	RIN		;FETCH THE ENTRY

	POPJ	P,	;AND EXIT

;PREPROCESS STRING SO WE CAN HASH ON IT
;THE WORDS CONTAINING THE STRING ARE BYTE-WISE REVERSED AND
;XOR'ED TOGETHER.
HASHST:	SETZ	K,	;CLEAR RECEIVING AC
	MOVE	J,6	;GET STRING POINTER

XLUP1:	MOVEI	N,5
	SETZ	M,

XLUP2:	ILDB	L,J	;GET A BYTE
	JUMPE	L,[XOR K,M
		JRST HASH2]

	LSHC	L,-7	;SHIFT BYTE INTO M
	SOJG	N,XLUP2	;DO ANOTHER IF M NOT FULL

	XOR	K,M	;M FULL, XOR IT INTT K
	JRST	XLUP1






IFN PIESLC,<
;ROUTINE TO CONVERT PIE-SLICE GROUP NAME TO AN INDEX.
;CALLED WITH SIXBIT GROUP NAME IN AC1.
;RETURNS +1 : NO SUCH GROUP
;        +2 : GROUP INDEX IN AC1.
;ALL ACS ARE PRESERVED (EXCEPT 1).
GRPLUK:: JUMPE A,R##		;DONT SEARCH IF ARG IS ZERO
	PUSH P,B
	PUSH P,C

	MOVEI B,NGRPS		;NUMBER OF PIE-SLICE GROUPS
	SETZ C,

GRPLU1:	CAMN A,GRPNM(C)		;DOES IT MATCH THIS ENTRY?
	 JRST GRPLU2		;YES

	ADDI C,NWDGRP		;ON TO NEXT ENTRY
	SOJG B,GRPLU1		;IF THERE IS ONE

GRPLU3:	POP P,C
	POP P,B
	RET

GRPLU2:	MOVN A,B
	ADDI A,NGRPS
	AOS -2(P)
	JRST GRPLU3

;ROUTINE TO CHANGE PIE-SLICE GROUP INDEX FOR A JOB. NEW INDEX IS
;IN AC1. RETURNS +1 ALWAYS.
CHGGRP::ADD P,BHC##+7		;COVER SPACE FOR ACS
	JUMPGE P,MSTKOV##	;IF STACK OVERFLOWS
	MOVEM 2,-6(P)
	MOVEI 2,-5(P)
	HRLI 2,3
	BLT 2,0(P)		;SAVE ACS 2-10

	MOVE 10,1		;SAVE NEW GROUP INDEX
	MOVE 1,JOBNO
	CALL UPDPIE##		;ACCUMULATE CPU IN OLD GROUP

	NOINT
	LOCK GRPLOK## ;NO DSHARE UPDATING WHILE THIS HAPPENS

	MOVE 2,PIEGRP(1)	;GET CURRENT GROUP
	SOS NJBGRP##(2)		;REDUCE COUNT OF JOBS PER GROUP

	MOVSI 3,-NUFKS		;GET READY TO LOOP THRU SYSFK
	MOVSI 4,RNLS##		;BIT IN FKFLGS THAT IDENTIFIES ACTIVE
				;PROCESS
	MOVSI 5,(-1.0)		;WE'LL NEED THESE LATER
	MOVSI 6,(1.0)

	SKIP SYSFK		;TOUCH BEFORE GOING NOSKED
	NOSKED
CHGGR3:	HRRZ 7,SYSFK(3)		;GET INDEX FOR FORK IN THIS JOB
	CAIN 7,-1		;THIS SLOT IN USE?
	 JRST CHGGR4		;NO
	TDNN 4,FKFLGS##(7)	;ACTIVE FORK?
	 JRST CHGGR4		;NO
	FADRM 5,NAPROC##(2)	;YES, REDUCE ACTIVE PROCESS COUNT
				;FOR OLD GROUP
	FADRM 6,NAPROC(10)	;AND INCREASE FOR NEW ONE
CHGGR4:	AOBJN 3,CHGGR3		;DO IT AGAIN IF ANY LEFT
	MOVEM 10,PIEGRP(1)	;RECORD NEW GROUP INDEX
	AOS NJBGRP(10)		;INCREASE COUNT OF JOBS PER GROUP
	SETZM RJQNT##		; SMASH REMAINING RUNTIME TO GET NEW QUEUE.
	OKSKED
	UNLOCK GRPLOK
	OKINT

	HRLZI 10,-6(P)		;GET READY TO RESTORE ACS
	HRRI 10,2
	BLT 10,10
	SUB P,BHC+7
	RET

> ; END PIE-SLICE SCHEDULER CONDITIONAL

	END ; OF ACCTJS.MAC